Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/oddwnd/irregwin.ctl

Text File | 1997-12-10 | 5KB | 160 lines

VERSION 5.00
Begin VB.UserControl UserControl1
   BackColor       =   &H00FF0000&
   BackStyle       =   0  'Transparent
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   PaletteMode     =   2  'Custom
   ScaleHeight     =   3600
   ScaleWidth      =   4800
End
Attribute VB_Name = "UserControl1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Dim oldpos As RECT
Dim oldparent As Long
Dim clicked As Boolean
Dim oldpic As Picture

Enum BackStyle
  [Transparent] = 0
  [Opaque] = 1
End Enum
Private Sub UserControl_DblClick()

'we'll use a simple flag here

If clicked = False Then

  'Set the extender.visible to false
  'NB: This stops the Visual Basic from
  'thinking the window is still inside
  'the form when it is in fact outside!
  UserControl.Extender.Visible = False

  'Get old window position (just for clean-
  '-liness) and brevity
  GetWindowRect UserControl.hwnd, oldpos

  'retrieve old parent window
  oldparent = GetParent(UserControl.hwnd)

  'prevent it from appearing in the
  'system desktop task windows.
  SetWindowText UserControl.hwnd, "Baby Face"

  'determine new parent
  SetWindowLong UserControl.hwnd, GWL_HWNDPARENT, 0&
  SetParent UserControl.hwnd, ByVal 0&
  'maintain window position and SHOW the
  'window.
  'NB: This DOES NOT AFFECT the Extender.Visible property!
  'WOW! Irregular - Truly irregular Windows.
  SetWindowPos UserControl.hwnd, -1, oldpos.Left, oldpos.Top, (oldpos.Right - oldpos.Left), (oldpos.Bottom - oldpos.Top), &H40
  'set for -1 for top-most (always remain on top)
  'change to 0 for default.
  Beep
  clicked = True

Else

  'Restore the window's defaults.
  'NOTE THIS: When you use Me.Hide on the
  'VB Form this control is on, you will not
  'affect the control. However, if you
  'minimize the form you'll also minimize
  'this outside-of-form irregular window
  'as well (this is by-design windows
  'behaviour, and you can subclass the VB
  'form and prevent this from happening
  'if you really want to).
  SetWindowLong UserControl.hwnd, GWL_HWNDPARENT, oldparent
  SetParent UserControl.hwnd, oldparent
  UserControl.Extender.Visible = True
  clicked = False

End If

'**************************************'
'* So, Anybody thought this was not   *'
'* possible. It's been a dream of our *'
'* programmers to be able to do this! *'
'**************************************'

End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
ReleaseCapture
SendMessage UserControl.hwnd, 161, 2, ByVal 0&
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackStyle
Public Property Get BackStyle() As BackStyle
  BackStyle = UserControl.BackStyle
End Property

Public Property Let BackStyle(ByVal New_BackStyle As BackStyle)
  UserControl.BackStyle() = New_BackStyle
  PropertyChanged "BackStyle"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,MaskPicture
Public Property Get MaskPicture() As Picture
  Set MaskPicture = UserControl.MaskPicture
End Property

Public Property Set MaskPicture(ByVal New_MaskPicture As Picture)
  Set UserControl.MaskPicture = New_MaskPicture
  PropertyChanged "MaskPicture"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Picture
Public Property Get Picture() As Picture
  Set Picture = UserControl.Picture
End Property

Public Property Set Picture(ByVal New_Picture As Picture)
  Set UserControl.Picture = New_Picture
  UserControl.PaletteMode = 2
  Set UserControl.Palette = New_Picture
  PropertyChanged "Picture"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
  BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  UserControl.BackColor() = New_BackColor
  PropertyChanged "BackColor"
End Property

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

  UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 0)
  Set MaskPicture = PropBag.ReadProperty("MaskPicture", Nothing)
  Set Picture = PropBag.ReadProperty("Picture", Nothing)
  UserControl.BackColor = PropBag.ReadProperty("BackColor", &HFF0000)
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

  Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 0)
  Call PropBag.WriteProperty("MaskPicture", MaskPicture, Nothing)
  Call PropBag.WriteProperty("Picture", Picture, Nothing)
  Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &HFF0000)
End Sub